home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / tjgold.zip / INSTALL.003 / DEMDATE2.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-29  |  4KB  |  127 lines
  1. {--------------------------------------------------------------------------}
  2. {                Product: TechnoJock's Turbo Toolkit GOLD                  }
  3. {                                                                          }
  4. {                     TTT GOLD - DEMO PROGRAM                        }
  5. {                                                                          }
  6. {                Copyright 1986-1995  TechnoJock Software, Inc.            }
  7. {                           All Rights Reserved                            }
  8. {                          Restricted by License                           }
  9. {--------------------------------------------------------------------------}
  10.  
  11. {Description: DEMDATE2.PAS
  12.               Demonstrates some capabilities of the GOLDDATE UNIT.
  13. }
  14.  
  15. program DEMDATE2;
  16.  
  17. {$I GOLDFLAG.INC}
  18.  
  19. uses CRT, GoldAttr, GoldFast, GoldCal, GoldDate, GoldMisc, GoldReal,
  20.           GoldHard, GoldKey, GoldIO, GoldIO2, GoldIO3, GoldStr, GoldWin;
  21.  
  22. var
  23.   TestVar: dates;
  24.   Msg: string;
  25.   DVar,MVar,YVar: longint;
  26.   Action: gAction;
  27.  
  28. procedure SetScreen;
  29. {}
  30. begin
  31.    Clear(WhiteOnBlack,'▓');
  32.    ClearLine(1,RedOnLightGray);
  33.    WriteCenter(1,UseTint,'TTT Gold');
  34.    ClearLine(25,BlackOnLightGray);
  35.    WritePlain(8,25,'│');
  36. end; { SetScreen }
  37.  
  38. procedure SetVars;
  39. {Sets the default values for the fields}
  40. begin
  41.    TestVar := TodayInJul;
  42.    DVar := 0;
  43.    MVar := 0;
  44.    YVar := 0;
  45. end; { SetVars }
  46.  
  47. {$IFOPT F-}
  48.    {$DEFINE FOFF}
  49.    {$F+}
  50. {$ENDIF}
  51.  
  52. procedure MyDateHook(CurrentField:byte;var Refresh:byte);
  53. {}
  54. begin
  55.    PartClear(4,9,56,9,BlackOnLightGray,' ');
  56.    WriteBetween(3,57,9,BlackOnLightGray,'The relative date is: '+
  57.    FancyDateStr(StrToJul(RelativeDateYMD(JulToStr(TestVar,MMDDYY),MMDDYY,YVar,MVar,DVar),MMDDYY),true,true));
  58. end; { MyDateHook }
  59.  
  60. {$IFDEF FOFF}
  61.    {$F-}
  62.    {$UNDEF FOFF}
  63. {$ENDIF}
  64.  
  65. procedure SetFields;
  66. {Defines the form by postioning the fields, linking the fields to
  67.  variables, and adding labels, hotkeys and messages}
  68. begin
  69.    CreateForms(1);
  70.    ActivateForm(1);
  71.    SetFormWindow(10,5,71,19,1);
  72.    WinSetTitle(FormWinNum,'  DATE RELATIVITY DEMO  ');
  73.    WinSetType(FormWinNum,WMove);
  74.    WinSetShowNum(FormWinNum,false);
  75.    ActivateWindow(FormWinNum);
  76.    WinDisplay(FormWinNum);
  77.    Box3D(2,8,58,10,WhiteOnLightGray,BlackOnLightGray,1);
  78.    WriteAT(8,6,BlackOnLightGray,'[ adjust the relative Years, Months, and Days ]');
  79.    {all the field, label and message coordinates are now relative
  80.     to the top left corner of the window pane}
  81.    KwikAddField(1,37,2);
  82.    KwikAddField(2,12,4);
  83.    KwikAddField(3,31,4);
  84.    KwikAddField(4,47,4);
  85.    KwikAddField(5,30,12);
  86.    KwikAddLastField(6, 43,12);
  87.    AssignHindHook(MyDateHook);
  88.    {define each field}
  89.    SpinDropDateField(1, TestVar, MMDDYY, '',0,0);
  90.    SetLabel(1, LabelLeft,LabelLeft,'~E~nter the starting date');
  91.    SetHK(1,274);
  92.    SpinLongField(2,YVar,5,0,0,1);
  93.    SetLabel(2,LabelLeft,LabelLeft,'Years');
  94.    SpinLongField(3,MVar,5,0,0,1);
  95.    SetLabel(3,LabelLeft,LabelLeft,'Months');
  96.    SpinLongField(4,DVar,5,0,0,1);
  97.    SetLabel(4,LabelLeft,LabelLeft,'Days');
  98.    ButtonDefaultField(5,WinVars.OKButStr,Finished);
  99.    ButtonField(6,WinVars.CancelButStr,Escaped);
  100.    {buttons}
  101. end; { SetFields }
  102.  
  103. begin
  104. {$IFOPT D+}
  105.    HeapRecord;
  106. {$ENDIF}
  107.    SetScreen;
  108.    SetVars;
  109.    SetFields;
  110.    MouseShow(true);
  111.    Action := EditForm(1);
  112.    if Action = Finished then
  113.       Msg := '^The relative date is:||^'+
  114.     FancyDateStr(StrToJul(RelativeDateYMD(JulToStr(TestVar,MMDDYY),MMDDYY,YVar,MVar,DVar),MMDDYY),true,true)
  115.    else
  116.       Msg := 'You choose to leave!';
  117.    PromptOK(' Result ',Msg);
  118.    DisposeFormWin;
  119.    DisposeFields;
  120.    DisposeForms;
  121.    MouseShow(false);
  122.    clrscr;
  123. {$IFOPT D+}
  124.    HeapCheck;
  125. {$ENDIF}
  126. end.
  127.